home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / tttool30.arc / IO.TTT < prev    next >
Text File  |  1986-09-28  |  16KB  |  551 lines
  1. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2. {                                                                           }
  3. {           T E C H N O J O C K S     T U R B O    T O O L K I T            }
  4. {                                                                           }
  5. {                      Module   :   IO.TTT                                  }
  6. {                                                                           }
  7. {                      Version  :   3.0 , October 1, 1986                   }
  8. {                                                                           }
  9. {                      Purpose  :   Fullscreen editing procedures           }
  10. {                                                                           }
  11. {                 Requirements  :   Decl.TTT                                }
  12. {                                   Fastwrit.TTT                            }
  13. {                                   Window.ttt                              }
  14. {                                   Misc.ttt                                }
  15. {                                                                           }
  16. {   Procedures:                                                             }
  17. {        IO_Setfields(No_of_fields:byte);                                   }
  18. {        IO_SetColors(HiFore,Hiback,LoFore,LoBack,MsgFore,MsgBack:byte);    }
  19. {        IO_DefineMsg(DefID,DefX,DefY : byte; DefString : string80);        }
  20. {        IO_DefineStr(DefID,DefU,DefD,DefL,DefR,DefX,DefY:byte;             }
  21. {                        Var DefString : string80;                          }
  22. {                        DefFormat : string80);                             }
  23. {        IO_HelpProc(location : integer);                                   }
  24. {        IO_DisplayFields;                                                  }
  25. {        IO_AllowEsc(OK:boolean);                                           }
  26. {        IO_SoundBeeper(OK:boolean);                                        }
  27. {        IO_Edit(var Return_code : integer);                                }
  28. {        IO_ResetFields;                                                    }
  29. {                                                                           }
  30. {                                                Bob Ainsbury               }
  31. {                                                Technojock                 }
  32. {                                                Houston                    }
  33. {                                                (713) 293-2760             }
  34. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  35.  
  36. Procedure Abend(Code:byte;value:real);    {fatal error -- msg and halt}
  37. var Message:string80;
  38. begin
  39. {Clrscr;}
  40. Case Code of
  41. 1 : Message :=
  42. 'Fatal Error 1 : Invalid value of '+Real_to_Str(value,0)+
  43. ' in IO_SetFields with a MaxInputFields of '+Real_to_Str(MaxInputFields,0);
  44. 2 : Message :=
  45. 'Fatal Error 2 : Insufficient Memory on Heap. Available '
  46. +Real_to_Str(MemAvail_in_Bytes,0)+'. Required '+Real_to_Str(value,0);
  47. 3 : Message :=
  48. 'Fatal Error 3 : Define IO_Setfields before IO_DefineStr';
  49. 4 : Message :=
  50. 'Fatal Error 4 : IO_DefineStr ID: '+Real_to_Str(value,0)+' out of range';
  51. 5 : Message :=
  52. 'Fatal Error 5 : Invalid exit field defined in IO_DefinStr ID: '
  53. +Real_to_Str(value,0);
  54. 6 : message :=
  55. 'Fatal Error 6 : Invalid X or Y value defined in IO_DefineStr ID: '
  56. +Real_to_Str(value,0);
  57. 7 : Message :=
  58. 'Fatal Error 7 : Define IO_Setfields before IO_DefineMsg';
  59. 8 : Message :=
  60. 'Fatal Error 8 : IO_DefineMsg ID: '+Real_to_Str(value,0)+' out of range';
  61. 9 : message :=
  62. 'Fatal Error 9 : Invalid X or Y value defined in IO_DefineMsg ID: '
  63. +Real_to_Str(value,0);
  64. 10 : Message :=
  65. 'Fatal Error 10 : Only use IO_ResetFields after IO_Setfields';
  66. 11 : Message :=
  67. 'Fatal Error 11 : IO_Setfields already operative, reset with IO_Resetfields';
  68. else Message := 'Aborting';
  69. end; {case}
  70. WriteAT(1,12,yellow,red,Message);
  71. Repeat Until keypressed;
  72. Halt;
  73. end;    {proc Abend}
  74.  
  75. Procedure Ding;
  76. begin
  77.  If IO_Settings.IO_BeepOn then
  78.   sound(750);delay(150);nosound;
  79. end;    {proc Ding}
  80.  
  81. Procedure Jumpto(location:integer);
  82. begin
  83.  inline($1e/$55/$8b/$ec/$8b/$5e/$0a/$ff/$d3/$5d/$1f);
  84. end;
  85.  
  86. Procedure IO_HelpProc(location : integer);
  87. begin
  88.  IO_Settings.HelpAddress := location;
  89. end;
  90.  
  91. Procedure InsertMode;       {change cursor style when in insert mode}
  92. begin
  93. IO_Settings.IO_Insert := not IO_Settings.IO_Insert;
  94. If IO_Settings.IO_Insert then
  95.  SizeCursor(4,7)
  96. else
  97.  SizeCursor(6,7);
  98. end;
  99.  
  100. Procedure IO_Setfields(No_of_fields:byte);
  101. var I:integer;
  102. Room_needed : real;
  103. begin
  104. If IO_Settings.IO_FieldsSet then Abend(11,0);       {already set}
  105. If No_of_Fields in [1..MaxInputFields] then
  106. begin
  107.  Room_needed := sizeof(FieldDefn[0]^)*(1+No_of_fields);
  108.  If MemAvail_in_bytes > Room_needed then
  109.  begin
  110.   For I := 0 to No_of_fields do
  111.   begin
  112.    New(FieldDefn[I]);
  113.    New(FieldDefn[I]^.InString);
  114.    with FieldDefn[I]^ do
  115.    begin
  116.     Upfield     := 0;
  117.     Downfield   := 0;
  118.     Leftfield   := 0;
  119.     Rightfield  := 0;
  120.     X           := 0;
  121.     Y           := 0;
  122.     InString^   := '';
  123.     StrLength   := 0;
  124.     Format      := '';
  125.     Message     := '';
  126.     MsgX        := 0;
  127.     MsgY        := 0;
  128.     CursorX     := 0;
  129.     CursorInit  := 0;
  130.     StrLocX     := 1;
  131.    end;
  132.   end;
  133.   IO_Settings.TotalFields := No_of_Fields;
  134.   IO_Settings.IO_FieldsSet := true;
  135.  end
  136.  else {not enough heap space}
  137.   Abend(2,Room_needed); {end MemAvail If clause}
  138. end
  139. else  {Invalid No_of_fields}
  140.  Abend(1,No_of_fields);
  141. end;  {Proc IO_SetFields}
  142.  
  143. Procedure IO_SetColors(HiFore,Hiback,LoFore,LoBack,MsgFore,MsgBack:byte);
  144. begin
  145. With IO_Settings do
  146. begin
  147.  HiF := HiFore;
  148.  HiB := HiBack;
  149.  LoF := LoFore;
  150.  LoB := LoBack;
  151.  MsgF := MsgFore;
  152.  MsgB := MsgBack;
  153. end;
  154. end;    {Proc IO_SetColors}
  155.  
  156. Procedure IO_DefineMsg(DefID,DefX,DefY : byte; DefString : string80);
  157. begin
  158. If not IO_Settings.IO_FieldsSet then abend(7,0);
  159. If (DefID < 1) or (DefID > IO_Settings.TotalFields) then abend(8,DefID);
  160. If (DefX < 1) or (DefX > 80) or (DefY < 1) or (DefY > 25) then abend(9,DefID);
  161. With FieldDefn[Defid]^ do
  162. begin
  163.  MsgX := DefX;
  164.  MsgY := DefY;
  165.  Message := DefString;
  166. end;
  167. end;  {proc IO_DefineMsg}
  168.  
  169. Procedure IO_DefineStr(DefID,DefU,DefD,DefL,DefR,DefX,DefY:byte;
  170.                          Var DefString : string80;
  171.                          DefFormat : string80);
  172.  
  173.              Function Max_string_length : byte;
  174.              var I,Counter : byte;
  175.              begin
  176.              Counter := 0;
  177.              For I := 1 to length(DefFormat) do
  178.               if (DefFormat[I] in FmtChars) then
  179.                Counter := counter + 1;
  180.              Max_string_length := Counter;
  181.              end;  {sub func Max_String_Length}
  182.  
  183.              Function  Pos_of_First_Input_Char: byte;
  184.              var Counter : byte;
  185.              begin
  186.              Counter := 0;
  187.              Repeat
  188.               Counter := Counter + 1;
  189.              Until DefFormat[Counter] in FmtChars;
  190.              Pos_of_First_Input_Char := FieldDefn[DefID]^.X + counter - 1;
  191.              end;
  192. begin
  193. If not IO_Settings.IO_FieldsSet then Abend(3,0);
  194. If (DefID < 1) or (DefID>IO_Settings.TotalFields) then Abend(4,Defid);
  195. If  (DefU < 0)  or (DefU > IO_Settings.TotalFields)
  196.  or (DefD < 0)  or (DefD > IO_Settings.TotalFields)
  197.  or (DefL < 0)  or (DefL > IO_Settings.TotalFields)
  198.  or (DefR < 0)  or (DefR > IO_Settings.TotalFields)
  199. then Abend(5,Defid);
  200. If  (DefX < 1) or (DefX > 80)
  201.  or (DefY < 1) or (DefY > 25)
  202. then Abend(6,Defid);
  203. With FieldDefn[DefID]^ do
  204. begin
  205.     Upfield    := DefU;
  206.     Downfield  := DefD;
  207.     Leftfield  := DefL;
  208.     Rightfield := DefR;
  209.     X          := DefX;
  210.     Y          := DefY;
  211.     InString   := ptr(seg(DefString),ofs(DefString));
  212.     StrLength  := Max_String_length;
  213.     Format     := DefFormat;
  214.     CursorX    := Pos_of_First_Input_Char;
  215.     CursorInit := Pos_of_First_Input_Char;
  216. end;
  217. end; {proc IO_DefineStr}
  218.  
  219. Function IO_FmtStr(Str,Fmt:string80):string80;
  220. var
  221. TempStr : string80;
  222. I,J : byte;
  223. begin
  224.  J := 0;
  225.  For I := 1 to length(Fmt) do
  226.  begin
  227.   If not (Fmt[I] in FmtChars) then
  228.   begin
  229.    TempStr[I] := Fmt[I] ;  {force any none format charcters into string}
  230.    J := J + 1;
  231.   end
  232.   else    {format character}
  233.   begin
  234.    If I - J <= length(Str) then
  235.     TempStr[I] := Str[I - J]
  236.    else
  237.     TempStr[I] := ' ';    {pad with blanks}
  238.   end;
  239.  end;
  240.  TempStr[0] := char(length(Fmt));  {set initial byte to string length}
  241.  IO_FmtStr := Tempstr;
  242. end;  {Func FmtStr}
  243.  
  244. Function Underline(Str:string80):string80;
  245. var I : integer;
  246. begin
  247. If IO_Settings.IO_PutUnderline then
  248.  for I := 1 to length(Str) do
  249.   If Str[I] = ' ' then Str[I] := '_';
  250. Underline := Str;
  251. end;   {func Underline}
  252.  
  253. Procedure Hilight(ID:byte);      {display cell in bright colors}
  254. begin
  255. with  FieldDefn[ID]^ do
  256. WriteAT(X,Y,IO_Settings.HiF,IO_Settings.HiB,Underline(IO_FmtStr(InString^,Format)));
  257. end;
  258.  
  259. Procedure LoLight(ID:byte);      {display cell in dim colors}
  260. begin
  261. with  FieldDefn[ID]^ do
  262. WriteAT(X,Y,IO_Settings.LoF,IO_Settings.LoB,Underline(IO_FmtStr(InString^,Format)));
  263. end;
  264.  
  265. Procedure IO_DisplayFields;
  266. var I : integer;
  267. begin
  268. For I :=  1 to IO_Settings.TotalFields do
  269.  LoLight(I);
  270. IO_Settings.Displayed  := true;
  271. end;
  272.  
  273. Procedure IO_AllowEsc(OK:boolean);
  274. begin
  275.  IO_Settings.IOEsc := OK;
  276. end;    {proc IO_AllowEsc}
  277.  
  278. Procedure IO_SoundBeeper(OK:boolean);
  279. begin
  280.  IO_Settings.IO_BeepOn := OK;
  281. end;    {proc IO_SoundBeeper}
  282.  
  283. Procedure IO_ResetFields;
  284. var I : integer;
  285. begin
  286. If not IO_Settings.IO_FieldsSet then abend(10,0);
  287. For I := 1 to IO_Settings.TotalFields do
  288.  Dispose(FieldDefn[I]);
  289. With IO_Settings do
  290. begin
  291.  IO_FieldsSet := false;
  292.  TotalFields := 0;
  293.  IOEsc := false;
  294.  Displayed := false;
  295.  IO_Beepon := true;
  296.  IO_PutUnderline := true;
  297.  IO_Insert := false;
  298.  CurrentField := 1;
  299.  HelpAddress := 0;
  300. end; {with}
  301. end; { proc IO_ResetFields }
  302.  
  303. {
  304. ****************************
  305. *      Main Procedure      *
  306. ****************************
  307. }
  308.  
  309. Procedure IO_Edit(var Return_code : integer);
  310. const finished : boolean = false;
  311. var  OldLine : line;
  312.  
  313.     Procedure DisplayMessage(ID:byte);
  314.     var I,LocC : integer;
  315.     begin
  316.     For I := 1 to 80 do
  317.     begin
  318.      LocC := (I-1)*2 + (FieldDefn[ID]^.MsgY-1)*160;
  319.      OldLine[I].C := chr(mem[$b800:LocC]);
  320.      OldLine[I].A := mem[$B800:LocC+1];
  321.     end;
  322.     With FieldDefn[ID]^ do
  323.      WriteAT(MsgX,MsgY,IO_Settings.MsgF,IO_Settings.MsgB,Message);
  324.     end; {sub sub proc DisplayMessage}
  325.  
  326.     Procedure RemoveMessage(ID:byte);
  327.     var I,LocC : integer;
  328.     begin
  329.     For I := 1 to 80 do
  330.     begin
  331.      LocC := (I-1)*2 + (FieldDefn[ID]^.MsgY-1)*160;
  332.      Mem[$B800:LocC] := ord(OldLine[I].C);
  333.      Mem[$B800:locC + 1] := OldLine[I].A;
  334.     end;
  335.     end; {sub sub proc RemoveMessage}
  336.  
  337.   Procedure Change_Fields(ID:byte);
  338.   begin
  339.    LoLight(IO_Settings.CurrentField);
  340.    If FieldDefn[IO_Settings.CurrentField]^.MsgX > 0 then
  341.     RemoveMessage(IO_Settings.CurrentField);
  342.    If ID = 0 then
  343.    begin
  344.     Finished := true;
  345.     Return_Code := 0;
  346.    end
  347.    else
  348.    begin
  349.     IO_Settings.CurrentField := ID;
  350.     If IO_Settings.IO_Insert = true then      {switch insert off}
  351.       InsertMode;
  352.     HiLight(IO_Settings.CurrentField);
  353.    If FieldDefn[IO_Settings.CurrentField]^.MsgX > 0 then
  354.     DisplayMessage(IO_Settings.CurrentField);
  355.     With FieldDefn[IO_Settings.CurrentField]^ do
  356.     GotoXY(CursorX,Y);
  357.     Ding;
  358.    end;  {If ID = 0};
  359.   end;  {proc change fields}
  360.  
  361.   Procedure Erase_Field(ID:byte);
  362.   begin
  363.   with FieldDefn[ID]^ do
  364.   begin
  365.    Instring^ := '';
  366.    CursorX   := CursorInit;
  367.    StrLocX := 1;
  368.   end;
  369.   end;
  370.  
  371.   Procedure Global_Erase;
  372.   var I : integer;
  373.   begin
  374.   {MayBe paint an are you sure window}
  375.   For I :=  1 to IO_Settings.TotalFields do
  376.    Erase_Field(I);
  377.   IO_DisplayFields;
  378.   IO_Settings.CurrentField := 1;
  379.   end;
  380.  
  381.   Procedure Cursor_Right;
  382.   begin
  383.   With FieldDefn[IO_Settings.CurrentField]^ do
  384.   begin
  385.    If (StrLocX <= length(InString^)) and (StrLocX < StrLength) then
  386.    begin
  387.     StrLocX := StrLocX + 1;
  388.     Repeat
  389.      CursorX := CursorX + 1;
  390.     Until Format[CursorX + 1 - X] in FmtChars;
  391.    end;
  392.    GotoXY(CursorX,Y);
  393.   end; {with}
  394.   end; {Proc Cursor_Right}
  395.  
  396.   Procedure Cursor_Left;
  397.   begin
  398.   With FieldDefn[IO_Settings.CurrentField]^ do
  399.   begin
  400.    If StrLocX > 1 then
  401.    begin
  402.     StrLocX := StrLocX - 1;
  403.     Repeat
  404.      CursorX := CursorX - 1;
  405.     Until Format[CursorX + 1 - X] in FmtChars;
  406.    end;
  407.   end;  {with}
  408.   end;  {Proc Cursor_left}
  409.  
  410.   Procedure Delete_Char;
  411.   var
  412.   Temp : boolean;
  413.   I : integer;
  414.   begin
  415.   Temp := false;                                 {insert a space if there are}
  416.   with FieldDefn[IO_Settings.CurrentField]^ do   {non format characters}
  417.   begin
  418.    For I := 1 to length(Format) do
  419.    If not (Format[I] in FmtChars) then
  420.     Temp := true;
  421.    Delete(InString^,StrLocX,1);
  422.    If Temp = true then
  423.     Insert(' ',Instring^,StrlocX);
  424.   end;  {with}
  425.   end;  {Delete_Chars}
  426.  
  427.   Procedure Backspaced;
  428.   begin
  429.   with FieldDefn[IO_Settings.CurrentField]^ do
  430.   begin
  431.    If StrLocX > 1 then
  432.    begin
  433.     Cursor_Left;
  434.     Delete(InString^,StrLocX,1);
  435.    end;
  436.   end;  {with}
  437.   end;  { Proc Backspaced }
  438.  
  439.   Procedure Activity;
  440.   var K : char;
  441.   begin
  442.   Wait_for_KeyPress(K);
  443.   If K in [IOEsc1, IOEsc2, IOEnter, IOBackSp, IOTab] then Funckey := true;
  444.   If Funckey = true then
  445.   begin
  446.    Case K of
  447.    IOEsc1 : begin
  448.              If IO_Settings.IOEsc then
  449.              begin
  450.               Finished := true;
  451.               Return_Code := 1;
  452.              end
  453.              else
  454.               Ding;
  455.             end;
  456.  
  457.    IOEsc2 : begin
  458.              If IO_Settings.IOEsc then
  459.              begin
  460.               Finished := true;
  461.               Return_Code := 2;
  462.              end
  463.              else
  464.               Ding;
  465.             end;
  466.  
  467.    IOFinish : begin
  468.                Finished := true;
  469.                Return_code := 0;
  470.               end;
  471.  
  472.    IORightFld,
  473.    IOTab,
  474.    IOEnter : Change_Fields(FieldDefn[IO_Settings.CurrentField]^.RightField);
  475.  
  476.    IOLeftFld,
  477.    IOShiftTab :Change_Fields(FieldDefn[IO_Settings.CurrentField]^.LeftField);
  478.  
  479.    IOBackSp : Backspaced;
  480.  
  481.    IODel    : Delete_Char;
  482.  
  483.    IOLeft   : Cursor_Left;
  484.  
  485.    IORight  : Cursor_Right;
  486.  
  487.    IOUp     : Change_Fields(FieldDefn[IO_Settings.CurrentField]^.UpField);
  488.  
  489.    IODown   : Change_Fields(FieldDefn[IO_Settings.CurrentField]^.DownField);
  490.  
  491.    IOErase    : Erase_Field(IO_Settings.CurrentField);
  492.  
  493.    IOTotErase : Global_Erase;
  494.  
  495.    IOIns      : InsertMode;
  496.  
  497.    IOHelp     : If IO_Settings.HelpAddress <> 0 then
  498.                  Jumpto(IO_Settings.HelpAddress);
  499.  
  500.    else Ding;
  501.    end; {case}
  502.   end
  503.   else {not a function key}
  504.   If K in [#32..#126] then
  505.   with FieldDefn[IO_settings.CurrentField]^ do
  506.   begin
  507.    If Format[CursorX - X + 1] = '!' then K := upcase(K);
  508.    If ((K in ['0'..'9','.']) and (Format[CursorX - X + 1] = '#'))
  509.    or ((K in ['a'..'z','A'..'Z',' ',',','.',';',':']) and
  510.        (Format[CursorX - X + 1] = '@'))
  511.    or (Format[CursorX - X + 1] = '*')
  512.    or (Format[CursorX - X + 1] = '!') then
  513.    begin
  514.     If IO_Settings.IO_Insert then          {in insert mode}
  515.     begin
  516.      If length(Instring^) < StrLength then
  517.      begin
  518.       Insert(K,Instring^,StrLocX);
  519.       Cursor_Right;
  520.      end
  521.      else Ding;
  522.     end
  523.     else                                    {in overlay mode}
  524.     begin
  525.      Delete(Instring^,StrLocX,1);
  526.      Insert(K,Instring^,StrLocX);
  527.      Cursor_Right;
  528.     end; {If insert}
  529.    end
  530.    else Ding; {end if K in statement}
  531.   end;  {with and big IF Funckey}
  532.   HiLight(IO_Settings.CurrentField);
  533.   With FieldDefn[IO_Settings.CurrentField]^ do
  534.     GotoXY(CursorX,Y);
  535.   end;    {Proc Activity}
  536.  
  537.  
  538. begin   {IO_Edit}
  539. If IO_Settings.Displayed = false then IO_DisplayFields;
  540. Hilight(IO_Settings.CurrentField);
  541. If FieldDefn[IO_Settings.CurrentField]^.MsgX > 0 then
  542. DisplayMessage(IO_Settings.CurrentField);
  543. GotoXY(FieldDefn[IO_Settings.CurrentField]^.CursorX,
  544.        FieldDefn[IO_Settings.CurrentField]^.Y);
  545. Finished := false;
  546. repeat
  547.  Activity
  548. until Finished;
  549. end;   {IO_Edit}
  550.  
  551.